;;; firemacs.el --- 
;;{{{ License

;; Copyright 2006 Lukas Loehrer
;; Parts of this file were lifted from emacs-w3m.
;;
;; Author: loehrerl [at] gmx [dot] net
;; Version: $Id: firemacs.el,v 0.0 2006/08/20 12:22:43 luke Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;}}}
;;{{{ Commentary

;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'firemacs)

;;}}}

;;; History:
;; 

;;; Code:
;;{{{ Required libraries

(eval-when-compile
  (require 'cl))
(require 'mozremote)
(require 'mozremote-object)
(require 'firemacs-buffer)
(require 'firemacs-utils)
(require 'tones)
(require 'wget)

;;}}}

;;{{{ Firemacs mode definition

(defvar firemacs-remote-browser nil
  "Reference to the remote browser object
associated with this firemacs buffer.")

(defvar firemacs-mode-hook nil "Startup hook for firemacs-mode.")

(defvar firemacs-mode-map nil
  "Keymap for firemacs-mode.")

(defun firemacs-mode (&optional browser	)
  "A mode for interacting with Mozilla Firefox."
  ;; Not to be called interactively.
  (kill-all-local-variables)
  (buffer-disable-undo)
  (use-local-map firemacs-mode-map)
  (setq major-mode 'firemacs-mode
        mode-name "*firemacs*"
		buffer-read-only t)
  (put 'firemacs-mode 'mode-class 'special)
  (add-hook 'kill-buffer-hook 'firemacs-kill-hook nil t)
  (set-buffer-multibyte t)
  ; Initialize buffer local variables
  (set (make-local-variable 'firemacs-remote-browser) 
	   (or browser (firemacs-browser-new)))
  (set (make-local-variable 'firemacs-buffer-node-table)
	   (make-hash-table))
  (set (make-local-variable  'fm-session-history-current-id) nil)
  (set (make-local-variable 'fm-session-history-alist) nil)
  ; Run mode hook
  (run-hooks 'firemacs-mode-hook 'after-change-function))

(defun firemacs-kill-hook ()
  "Clean up buffer before being killed."
  (when (and (mozremote-object-descriptor-valid-p firemacs-remote-browser) (mozremote-connected-p))
	(mozremote-object-call-method nil firemacs-remote-browser "close"))
  (let ((inhibit-read-only t))
	(firemacs-buffer-clear))
  (setq firemacs-remote-browser nil
		firemacs-buffer-node-table nil))

;;{{{Hooks

(defvar firemacs-rendering-done-hook nil
  "Hook that is called when a new page has loaded completely.")

(defvar firemacs-partial-update-hook nil
  "Hook that is called when the page is updated partially.")


;;}}}

;;{{{Customize

(defgroup firemacs nil
  "Customization variables for firemacs.")


(defcustom firemacs-update-buffer-dynamically t
  "Buffer is updated dynamically, whenever the DOM is changed.

This can degrade performance when a lot of changes occur all the time."
  :group 'firemacs
  :type 'boolean)

(defun firemacs-toggle-dynamic-updates ()
  (interactive)
  (setq firemacs-update-buffer-dynamically (not firemacs-update-buffer-dynamically))
  (message "Turned %s dynamic page updates." (if firemacs-update-buffer-dynamically "on" "off")))

;;}}}


(defun firemacs-browse-url (url &optional new-session)
  (interactive (progn
		 (require 'browse-url)
		 (browse-url-interactive-arg "Firemacs URL: ")))
  (if new-session
	  (firemacs-goto-url-new-session url)
	(firemacs-goto-url url)))

;;}}}
;;{{{ Functions that interact with Firefox

(defun firemacs-browser-new ()
  "Create new remote browser instance in firefox and get reference to it."
  (mozremote-call-sync "Browsing" "getNewBrowserWindow"))

;;}}}
;;{{{Default actions for interactive elements

;;}}}
;;{{{Session history and remembering cursor position

(defvar fm-session-history-current-id nil
  "Session history id for the currently visited page.

This variable is local to the current Firemacs buffer.")

(defvar fm-session-history-alist nil
  "An alist mapping session history IDs to cursor positions.

This variable is local to the current Firemacs buffer.")

(defsubst fm-session-history-pos-for-id (id)
  "Return buffer position for session history id ID, nil if not yet recorded."
  (cdr (assoc id fm-session-history-alist)))

(defun fm-session-history-restore-pos (id)
  "Set point to the recorded position for for session history item ID."
  (let ((pos (fm-session-history-pos-for-id id)))
	(when pos
	  (goto-char pos))))

(defun fm-session-history-record-pos (id pos)
  "Add or update recorded position for session history item ID."
  (let ((cell (assoc id fm-session-history-alist)))
	(if cell
		(setcdr cell pos)
	  (push (cons id pos) fm-session-history-alist))))

(defun fm-session-history-update (new-id)
  "Record buffer position for current session history ID and set current ID to NEW-ID."
  (when fm-session-history-current-id
	(fm-session-history-record-pos fm-session-history-current-id (point)))
  (setq fm-session-history-current-id new-id))

;;}}}
;;{{{ Browser Event handlers

(defun firemacs-browser-event-handler (service spec args)
  "Handle events from the Browsing service.

Primary dispatch is performed on SPEC.
Events that concern only a single browser window will then
be dispatched further based on the 'target property in args."
  (cond
   ((equal "load-start" spec)
	(firemacs-on-load-start args))
   ((equal "load-complete" spec)
	(firemacs-on-load-complete args))
   ((equal "frame-load-complete" spec)
	(firemacs-on-frame-load-complete args)) 
   ((equal "subtree-modified" spec)
	(firemacs-on-subtree-modified args)) 
   ((equal "state-change" spec)
	(firemacs-on-state-change args))
   ((equal "internal-jump" spec)
	(firemacs-on-internal-jump args))
   ((equal "new-browser" spec)
	(firemacs-on-new-browser args)) 
   (t nil)))

(defmacro firemacs-with-buffer-of-event (event &rest body)
  `(let* ((win (mozremote-dictionary-get 'window ,event))
		  (buf (firemacs-buffer-of-window win)))
	 (when buf
	   (with-current-buffer buf
		 ,@body))))

(defun firemacs-on-load-complete (event)
  (firemacs-with-buffer-of-event event
								 (fm-session-history-update (mozremote-dictionary-get 'session-history-id event))
								 (message "Preparing %s"
										  (mozremote-dictionary-get 'title event))
								 (lexical-let ((event event))
								   (mozremote-object-with-result ir (firemacs-remote-browser "getIR") (current-buffer)
																 (firemacs-display ir)
																 (let* ((node-ref (mozremote-dictionary-get 'node event))
											(node (and node-ref (firemacs-node-for-ref node-ref))))
																   (cond
																	((and fm-session-history-current-id (mozremote-true-p (mozremote-dictionary-get 'is-restore event)))
																   (fm-session-history-restore-pos fm-session-history-current-id))
																	(node
																	 (goto-char (firemacs-node-start-pos node)))
																	(t 																   (goto-char (point-min)))))
																 (message "Rendering done.")
																 (run-hooks 'firemacs-rendering-done-hook)))))


(defun firemacs-on-load-start (event)
  (firemacs-with-buffer-of-event event
								 (message "Start loading %s"
										  (mozremote-dictionary-get 'url event))))


(defun firemacs-on-frame-load-complete (event)
  	(firemacs-with-buffer-of-event event
								   (tones-generate 1500 40 -12)
								   (let* ((node (mozremote-dictionary-get 'frame event)))
									 (firemacs-refresh-partial node))))

(defun firemacs-on-subtree-modified (event)
  (when firemacs-update-buffer-dynamically
	(firemacs-with-buffer-of-event event
								   (tones-generate 1500 40 -12)
								   (let* ((node (mozremote-dictionary-get 'node event)))
									 (firemacs-refresh-partial node)))))

(defun firemacs-on-state-change (event)
  (tones-generate 1000 50 -12)
  (tones-generate 1500 50 -12)
  (firemacs-with-buffer-of-event event
								 (let ((node (firemacs-node-for-ref (mozremote-dictionary-get 'node event))))
								   (when node 
									 (firemacs-node-set-property node 'fm-state
																 (if (mozremote-true-p (mozremote-dictionary-get 'checked event))
																	  "checked" "not checked"))))))

(defun firemacs-on-internal-jump (event)
  (tones-generate 440 50 -12)
  (firemacs-with-buffer-of-event event
								 (fm-session-history-update (mozremote-dictionary-get 'session-history-id event))
								 (let* ((recorded-pos (and fm-session-history-current-id (fm-session-history-pos-for-id fm-session-history-current-id)))
										(url (mozremote-dictionary-get 'fm-url event))
										(doc (mozremote-dictionary-get 'document event))
										(doc-node (and doc (firemacs-node-for-ref doc))))
								   (when (and doc-node url)
									 (firemacs-node-set-property doc-node 'fm-url url))
								   (if recorded-pos
									   (goto-char recorded-pos)
									 ;; else
									 (let* ((node-ref (mozremote-dictionary-get 'node event))
											(node (and node-ref (firemacs-node-for-ref node-ref))))
									   (if node
										   (goto-char (firemacs-node-start-pos node))
										 (message "Cannot find link target.")))))))


(defun firemacs-on-new-browser (event)
  "Handle new-browser event from Firefox.

Will ask the user whether to open a new buffer for the newly created browser window."
  (let ((browser (mozremote-dictionary-get 'browser event)))
	(if (y-or-n-p "A new browser window just opened. Create Firemacs buffer for it ")
		(let ((buffer (firemacs-create-buffer browser)))
		  (pop-to-buffer buffer))
	  (mozremote-object-call-method nil browser "close"))))
		
;;}}}
;;{{{Browsing commands

(defun firemacs-goto-url (url)
  "Visit URL in existing firemacs buffer."
  (interactive
   (list
	(firemacs-input-url)))
  (firemacs-buffer-setup)
  (pop-to-buffer (current-buffer))
  (mozremote-object-call-method nil firemacs-remote-browser "loadURL" url))

(defun firemacs-goto-url-new-session (url)
  "Visit url in new firemacs session."
  (interactive
	(list
	 (firemacs-input-url)))
  (let ((buffer (firemacs-create-buffer)))
	(set-buffer buffer)
	(firemacs-goto-url url)))
	
;;}}}
;;{{{Utility functions


(defun firemacs-alive-p (&optional visible)
  "Return a buffer in which firemacs is running.
If there is no Firemacs session, return nil.  If the optional VISIBLE
is non-nil, a visible Firemacs buffer is preferred.  The last visited
Firemacs buffer is likely to return if VISIBLE is omitted or there is
no visible buffer."
  (let* ((buffers (firemacs-list-buffers))
	 (buf (car buffers)))
    (if visible
	(progn
	  (setq visible nil)
	  (while (and (not visible)
		      buffers)
	    (when (get-buffer-window (car buffers) t)
	      (setq visible (car buffers)))
	    (setq buffers (cdr buffers)))
	  (or visible buf))
      buf)))


(defun firemacs-list-buffers ()
  "List all buffers in which firemacs is running."
  (let ((buffers (buffer-list))
		result)
	(save-current-buffer
	  (dolist (buffer buffers)
		(set-buffer buffer)
		 (when (eq major-mode 'firemacs-mode)
		   (push buffer result))))
	result))

(defun firemacs-create-buffer (&optional browser)
  (with-current-buffer (generate-new-buffer "*firemacs*")
	(condition-case err
		(progn 
		  (firemacs-mode browser)
		  (current-buffer))
	  (error
	   (kill-buffer (current-buffer))
	   (error (error-message-string err))))))

(defun firemacs-buffer-setup ()
  "Generate a new buffer, select it and set it up for firemacs.
When the current buffer has already been prepared, it won't bother to
generate a new buffer."
  (unless (eq major-mode 'firemacs-mode)
    (let ((buffer (firemacs-alive-p t)))
      (if buffer
		  (set-buffer buffer)
		(set-buffer (firemacs-create-buffer))))))

(defun firemacs-buffer-of-window (window)
  "Determine firemacs buffer associated with WINDOW.

This function could probably be implemented more efficiently."
  (dolist (buf (firemacs-list-buffers))
	(with-current-buffer buf
	  (if (eq window firemacs-remote-browser)
	  (return buf)))))


(defun firemacs-page-title (&optional arg)
  "Return URL of currently displayed web page.

If ARG is not nil, return URL of innermost frame instead if available."
  (let ((node (firemacs-find-role-in-lineage
			   (firemacs-buffer-node-at (point))
			   (if arg '(fm-role-document fm-role-frame) '(fm-role-document)))))
	(when node
	  (firemacs-node-get-property node 'fm-title))))


(defun firemacs-current-url (&optional arg)
  "Return URL of currently displayed web page.

If ARG is not nil, return URL of innermost frame instead if available."
  (let ((node (firemacs-find-role-in-lineage
			   (firemacs-buffer-node-at (point))
			   (if arg '(fm-role-document fm-role-frame) '(fm-role-document)))))
	(when node
	  (firemacs-node-get-property node 'fm-url))))

(defun firemacs-url-for-link-at-pos (pos)
  "Return URL for link at POS in current Firemacs buffer, nil if there is no link at POS."
  (let ((node (firemacs-find-role-in-lineage
			   (firemacs-buffer-node-at pos)
			   '(fm-role-link))))
	(when node
	  (firemacs-node-get-property node 'fm-url))))

(defvar firemacs-url-history nil
  "List of URLs read from the mimi-buffer.")
  
(defun firemacs-input-url ()
  "Read URL from minibuffer. I If current buffer is a firemacs buffer, use its current url as default."
  (let ((default ""))
	(when (eq major-mode 'firemacs-mode)
	  (setq default (firemacs-current-url)))
	(read-string	
	 "URL: "
	 default
	 'firemacs-url-history)))
	
;;}}}
;;{{{Display related functions

(defun firemacs-fill-region (start end)
  "Fills region between START and END, respecting hard newlines and using relatively long lines."
  (let ((use-hard-newlines t)
			  (fill-column 120))
		  (fill-region start end)))

(defun firemacs-display (ir)
  "Display ir in current buffer

IR can also just represent a subtree."
  (let ((inhibit-read-only t))
	(let ((role (mozremote-dictionary-get 'role ir)))
	  (cond
	   ((equal role "fm-role-document")
		;; Complete redisplay
		(firemacs-buffer-clear)
		(message "Begin rendering...")
		(firemacs-render-node ir 1)	
		(firemacs-fill-region (point-min) (point-max)))
	   (t
		;; Partial redisplay
		(let* ((ref (mozremote-dictionary-get 'ref ir))
			   (node (firemacs-node-for-ref ref)))
		  (when node
			(let ((start (firemacs-node-start-pos node))
				  (end (firemacs-node-end-pos node))
				  (priority (firemacs-node-get-property node 'priority))
				  (pos (point))
				  (parent (firemacs-parent-node node)))
			  (save-excursion
				(firemacs-remove-node node)
				(goto-char start)
				(let ((new-node (firemacs-render-node ir priority)))
				  ;; We delete the node content only here because
				  ;; otherwise the start of the following nodes will not move forward
				  ;; This is not a good solution, because it fails if (= start end)
				  (delete-region (point) (+ (point) (- end start)))
				  ;; Not sure if the following will always work
				  ;; correctly What happens if new-node does not start
				  ;; at the beginning of a line or not end at the end
				  ;; of aline?
				  (firemacs-fill-region (firemacs-node-start-pos new-node) (firemacs-node-end-pos new-node))
				  (when parent
					(firemacs-node-set-property new-node 'fm-parent parent)
					(setcar (memq node (firemacs-child-nodes parent)) new-node))))
;; Try to restore cursor position inside the updated region
			  (when (and (<= start pos) (< pos end))
				(goto-char pos))))))))))
				   

(defun  firemacs-refresh-partial (node)
  "Reread DOM information for NODE and its descendants and update the buffer accordingly."
  (mozremote-object-with-result ir (firemacs-remote-browser "getIR" node) (current-buffer) 
								(firemacs-display ir)
								(run-hooks firemacs-partial-update-hook)))

;;}}}
;;{{{ User commands

(defun firemacs-wget (&optional arg)
  "Interface to wget."
  (interactive "P")
  (ensure-major-mode 'firemacs-mode)
  (wget-api (firemacs-url-for-link-at-pos (point)) (firemacs-current-url) arg))

;;{{{Debugging

(defun firemacs-debug-show-stats ()
  (interactive)
  (with-output-to-temp-buffer "*firemacs-stats*"
	(princ (format "Number of live objects: %d\n" (hash-table-count mozremote-object-obtable)))
	(when (eq major-mode 'firemacs-mode)
	  (princ (format "Number of nodes in firemacs buffer: %d\n" (hash-table-count firemacs-buffer-node-table)))
	  (princ (format "Number of overlays in firemacs buffer: %d\n" (length (overlays-in (point-min) (point-max))))))))

;;}}}


(defun firemacs-do-default-action (pos)
  "Perform default action for position POS."
  (interactive  "d")
  (let ((node (firemacs-find-role-in-lineage
			   (firemacs-buffer-node-at pos)
			   firemacs-interactive-roles)))
	(unless node
	  (error "No interaction at this position"))
	(let ((node-ref (firemacs-ref-for-node node)))
	  (case (firemacs-node-role node)
	  (fm-role-link
	   (mozremote-object-call-method-sync
		firemacs-remote-browser
		"followLink"
		node-ref))
	  (fm-role-pushbutton
	   (mozremote-object-call-method-sync
		firemacs-remote-browser
		"pressPushButton"
		node-ref))
	  (fm-role-entry
	   (let ((new-text (firemacs-ui-input-line "Text: " (firemacs-node-get-property node 'fm-value))))
		 (mozremote-object-call-method-sync
		  firemacs-remote-browser "setTextEntryValue"
		  node-ref new-text)))
	  (fm-role-password
	   (let ((new-text (read-passwd "Enter password: ")))
		 (mozremote-object-call-method-sync
		  firemacs-remote-browser "setTextEntryValue"
		  node-ref new-text)))
	  (fm-role-checkbox
	   (let ((result (mozremote-object-call-method-sync firemacs-remote-browser
								   "toggleCheckbox" node-ref)))
		 (when result
		   (let ((checked (mozremote-dictionary-get 'checked result)))
			 (message "%s" (cond
							((mozremote-true-p checked) "checked")
							(t "not checked")))))))
	  (fm-role-radiobutton
	   (let ((result (mozremote-object-call-method-sync firemacs-remote-browser
														"selectRadiobutton" node-ref)))
		 (when result
		   (let ((checked (mozremote-dictionary-get 'checked result)))
			 (message "%s" (cond
							((mozremote-true-p checked) "selected")
							(t "not selected")))))))
	  (fm-role-combobox
	   (let ((current-state (mozremote-object-call-method-sync
							 firemacs-remote-browser
							 "getComboboxOptions" node-ref)))
		 (unless current-state
		   (error "Error retrieving options for combobox"))
		 (let ((new-choice 
				(firemacs-ui-select
				 "Make a choice: "
				 (mozremote-dictionary-get 'options current-state)
				 (mozremote-dictionary-get 'selected current-state))))
		   (when new-choice
			 (mozremote-object-call-method-sync
			  firemacs-remote-browser "selectComboboxOption"
			  node-ref new-choice)))))))))

;;{{{Cursor motion commands

(defun firemacs-next-line (arg)
  "Like next-line."
  (interactive "p")
  (next-line arg))

(defun firemacs-previous-line (arg)
  "Like previous-line."
  (interactive "p")
  (previous-line arg))



(defun firemacs-backward-sentence (&optional arg)
  "Just like backward-sentence. Just here so we have something to advice."
  (interactive "p")
  (backward-sentence arg))

(defun firemacs-forward-sentence (&optional arg)
  "Just like forward-sentence. Just here so we have something to advice."
  (interactive "p")
  (forward-sentence arg))

;;}}}
;;{{{Commands that move between webpages

(defun firemacs-link-follow ()
  (interactive))

(defun firemacs-history-next ()
  "Move forward in history."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (mozremote-object-call-method nil firemacs-remote-browser "goForward"))


(defun firemacs-history-previous ()
  "Move backwards in history."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (mozremote-object-call-method nil firemacs-remote-browser "goBackward"))

(defun firemacs-history-session-goto-index (index)
  "Go to session history entry INDEX."
  (interactive (list
				(progn
				  (ensure-major-mode 'firemacs-mode)
				  (let* ((sh (mozremote-object-call-method-sync firemacs-remote-browser "getSessionHistory"))
						 choices)
					(mozremote-array-do entry (mozremote-dictionary-get 'history sh)
										(push (mozremote-array-get 0 entry) choices ))
					(setq choices (nreverse choices))
					(firemacs-ui-select "Session history: " choices (mozremote-dictionary-get 'index sh))))))
  (mozremote-object-call-method-sync firemacs-remote-browser "gotoSessionHistoryIndex" index))

(defun firemacs-form-submit ()
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (let ((node (firemacs-find-role-in-lineage (firemacs-buffer-node-at (point)) firemacs-form-roles)))
	(if node
		(mozremote-object-call-method nil firemacs-remote-browser "submitForm" (firemacs-ref-for-node node))
	  (message "Not on a form element."))))

(defun firemacs-stop-loading ()
  "Stop loading the current webpage."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (mozremote-object-call-method nil firemacs-remote-browser "stopLoading"))


(defun firemacs-reload ()
  "Reload the current webpage."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (mozremote-object-call-method nil firemacs-remote-browser "reloadPage"))

;;}}}
;;{{{ Commands that move the cursor on the page

(defun firemacs-goto-next-role (roles &optional pred)
  "Move cursor the the beginning of the next node whose role is in ROLES."
  (let ((node (firemacs-next-node (point) roles pred)))
	  (when node
		(let ((start (firemacs-node-start-pos node)))
		  (goto-char start)))
	  node))


(defun firemacs-goto-previous-role (roles &optional pred)
  "Move cursor the the beginning of the next node whose role is in ROLES."
  (let ((node (firemacs-previous-node (point) roles pred)))
	  (when node
		(let ((start (firemacs-node-start-pos node)))
		  (goto-char start)))
	  node))

;;{{{Autogenerate most cycling commands

;; The following describes the commands to be generated
(defconst firemacs-jump-command-list
  (list
   (list "link" '(fm-role-link) "k")
   (list "visited-link" '(fm-role-link) "v" (lambda (node) (firemacs-node-get-property node 'fm-link-visited)))
   (list "unvisited-link" '(fm-role-link) "u" (lambda (node) (not (firemacs-node-get-property node 'fm-link-visited))))
   (list "frame" '(fm-role-frame) "m")
   (list "anchor" '(fm-role-link fm-role-pushbutton fm-role-entry fm-role-radiobutton fm-role-checkbox fm-role-combobox fm-role-password fm-role-textarea) "a")
   (list "table" '(fm-role-table) "t")

   (list "list" '(fm-role-list) "l")
   (list "listitem" '(fm-role-listitem) "i")

   (list "form-field" '(fm-role-entry fm-role-password fm-role-checkbox fm-role-radiobutton fm-role-combobox fm-role-pushbutton fm-role-textarea) "f")
   (list "pushbutton" '(fm-role-pushbutton) "b")
   (list "entry" '(fm-role-entry fm-role-password) "e")
   (list "checkbox" '(fm-role-checkbox) "x")
   (list "radiobutton" '(fm-role-radiobutton) "r")
   (list "combobox" '(fm-role-combobox) "c")
   )
  "List of automatically defined jump commands.")

(defun firemacs-make-jump-command-map ()
  "Create default key map for jump commands."
  (let ((map (make-sparse-keymap)))
		(loop for (name roles key &rest ignored) in firemacs-jump-command-list do
		  (define-key map key  (intern (concat "firemacs-next-" name)))
		  (define-key map (upcase key) (intern (concat "firemacs-previous-" name))))
	map))

(defmacro firemacs-define-jump-commands (name roles &optional key pred &rest args)
  "Define pair of commands for cycling forward and backward through page elements with role in ROLES."
  (let ((next-command (intern (concat "firemacs-next-" name)))
		(previous-command (intern (concat "firemacs-previous-" name))))
	`(progn
	   (defun ,next-command ()
		 ,(format "Move cursor to the next %s.\n\nThis command was generated by the macro firemacs-define-jump-commands." name)
		 (interactive)
		 (ensure-major-mode 'firemacs-mode)
		 (firemacs-goto-next-role (quote ,roles) ,pred))
	   (defun ,previous-command ()
		 ,(format "Move cursor to the previous %s.\n\nThis command was generated by the macro firemacs-define-jump-commands." name)
		 (interactive)
		 (ensure-major-mode 'firemacs-mode)
		 (firemacs-goto-previous-role (quote ,roles) ,pred)))))

;; Define the actual commands
(defmacro firemacs-define-jump-commands-from-spec (spec)
  (let ((spec1 (eval spec)))
  `(progn
	 ,@(loop for entry in spec1 collect
			  `(firemacs-define-jump-commands ,@entry)))))

(firemacs-define-jump-commands-from-spec firemacs-jump-command-list)

;;}}}

;; Some special movement commands
(defun firemacs-next-heading (&optional level)
  "Move point to the previous link or form field."
    (interactive"P")
  (ensure-major-mode 'firemacs-mode)
  (if (and (numberp level) (> level 0) (< level 7))
	  (firemacs-goto-next-role '(fm-role-heading) (lambda (node) (eq level (firemacs-node-get-property node 'fm-heading-level))))
	(firemacs-goto-next-role '(fm-role-heading))))
  
(defun firemacs-previous-heading (&optional level)
  "Move point to the previous link or form field."
    (interactive "P")
  (ensure-major-mode 'firemacs-mode)
  (if (and (numberp level) (< 0 level) (< level 7))
	  (firemacs-goto-previous-role '(fm-role-heading) (lambda (node) (eq level (firemacs-node-get-property node 'fm-heading-level))))
	(firemacs-goto-previous-role '(fm-role-heading))))


;;{{{Movement inside tables

(defun firemacs-move-to-table-cell (cell-info)
  (mozremote-dictionary-with cell-info
							 (cell row columns)
							 (let ((target-node (firemacs-node-for-ref cell)))
							   (goto-char (firemacs-node-start-pos target-node)))))


(defun firemacs-table-move-to-brevious-row()
  "Moves the cursor to the table cell above the current one."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (let ((start-cell (firemacs-find-role-in-lineage (firemacs-buffer-node-at (point))  '(fm-role-cell))))
	(unless start-cell
	  (error "Not in a table"))
	(let ((result (mozremote-object-call-method-sync firemacs-remote-browser "getTableCellInfoAbove" (firemacs-ref-for-node start-cell))))
	  (if (null result)
		  (message "Top of column.")
		(firemacs-move-to-table-cell result)))))


(defun firemacs-table-move-to-next-row()
  "Moves the cursor to the table cell above the current one."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (let ((start-cell (firemacs-find-role-in-lineage (firemacs-buffer-node-at (point))  '(fm-role-cell))))
	(unless start-cell
	  (error "Not in a table"))
	(let ((result (mozremote-object-call-method-sync firemacs-remote-browser "getTableCellInfoBelow" (firemacs-ref-for-node start-cell))))
	  (if (null result)
		  (message "Bottom of column.")
		(firemacs-move-to-table-cell result)))))


(defun firemacs-table-move-to-brevious-column()
  "Moves the cursor to the table cell above the current one."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (let ((start-cell (firemacs-find-role-in-lineage (firemacs-buffer-node-at (point))  '(fm-role-cell))))
	(unless start-cell
	  (error "Not in a table"))
	(let ((result (mozremote-object-call-method-sync firemacs-remote-browser "getTableCellInfoLeft" (firemacs-ref-for-node start-cell))))
	  (if (null result)
		  (message "Beginning of row.")
		(firemacs-move-to-table-cell result)))))


(defun firemacs-table-move-to-next-column()
  "Moves the cursor to the table cell above the current one."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (let ((start-cell (firemacs-find-role-in-lineage (firemacs-buffer-node-at (point))  '(fm-role-cell))))
	(unless start-cell
	  (error "Not in a table"))
	(let ((result (mozremote-object-call-method-sync firemacs-remote-browser "getTableCellInfoRight" (firemacs-ref-for-node start-cell))))
	  (if (null result)
		  (message "End of row.")
		(firemacs-move-to-table-cell result)))))

;;}}}

;;}}}
;;{{{ Informational commands

(defun firemacs-where-am-i ()
  "Speaks information about the current location of the cursor."
  (interactive))

(defun firemacs-page-info ()
  "We will see..."
  (interactive))

(defun firemacs-print-page-title (&optional arg)
  "Display title of currently displayed webpage and copy it to the kill ring.

With prefix argument, display title of innermost frame instead."
  (interactive "P")
  (ensure-major-mode 'firemacs-mode)
  (let ((title  (firemacs-page-title arg)))
	(when title
	  (kill-new title))
	(message "%s" (or title "No page title."))))

(defun firemacs-print-current-url (&optional arg)
  "Display URL of currently displayed webpage and copy it to the kill ring.

With prefix argument, display URL of innermost frame instead."
  (interactive "P")
  (ensure-major-mode 'firemacs-mode)
  (let ((url  (firemacs-current-url arg)))
	(when url
	  (kill-new url))
	(message "%s" (or url "could not determine url fo rcurrent page."))))

(defun firemacs-print-this-url (pos)
  (interactive "d")
  (let ((url (firemacs-url-for-link-at-pos pos)))
	(if url
		(progn
		  (kill-new url)
		  (message "%s" url))
	  (message "No URL at point."))))

;;}}}
;;{{{ Other actions

(defun firemacs-refresh ()
  "Reread DOM information from Firefox and update buffer accordingly."
  (interactive)
  (ensure-major-mode 'firemacs-mode)
  (mozremote-object-with-result ir (firemacs-remote-browser "getIR") (current-buffer)
								   (firemacs-display ir)
(goto-char (point-min))
		(message "Rendering done.")
								   (run-hooks 'firemacs-rendering-done-hook)))

(defun firemacs-download-url-at-point ()
  "Download url at point."
  (interactive))

;;}}}

;;}}}
;;{{{Setup default keymap

(unless firemacs-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
	(define-key map "\C-n" 'firemacs-next-line)
	(define-key map "\C-p" 'firemacs-previous-line)
	(define-key map "\M-e" 'firemacs-forward-sentence)
	(define-key map "\M-a" 'firemacs-backward-sentence)
    (define-key map "\t" 'firemacs-next-anchor)
	(define-key map [backtab] 'firemacs-previous-anchor)
	(define-key map (kbd "<RET>") 'firemacs-do-default-action)
	(define-key map "g" 'firemacs-goto-url)
	(define-key map "G" 'firemacs-goto-url-new-session)
	(define-key map "s" 'firemacs-history-session-goto-index)
	(define-key map "\C-d" 'firemacs-wget)
	(define-key map "c" 'firemacs-print-current-url)
	(define-key map "C" 'firemacs-print-page-title)
	(define-key map "u" 'firemacs-print-this-url)
	(define-key map "h" 'firemacs-next-heading)
	(define-key map "H" 'firemacs-previous-heading)
	(define-key map "f" 'firemacs-next-form-field)
	(define-key map "F" 'firemacs-previous-form-field)
	(define-key map "B" 'firemacs-history-previous)
	(define-key map "N" 'firemacs-history-next)
	(define-key map "\C-c\C-r" 'firemacs-toggle-dynamic-updates)
	(define-key map "r" 'firemacs-refresh)
	(define-key map "R" 'firemacs-reload)
	(define-key map "\C-c\C-k" 'firemacs-stop-loading)
	(define-key map "j" (firemacs-make-jump-command-map))
	;; Table navigation
	(define-key map [?\C-e up] 'firemacs-table-move-to-brevious-row)
(define-key map [?\C-e down] 'firemacs-table-move-to-next-row)
(define-key map [?\C-e left] 'firemacs-table-move-to-brevious-column)
(define-key map [?\C-e right] 'firemacs-table-move-to-next-column)
    (setq firemacs-mode-map map)))

;;}}}
;;{{{Firemacs library initialization

;; (add-hook 'mozremote-connect-hook
;; 		  (lambda ()
;; 			(mozremote-event-add-handler "Browsing" 'firemacs-browser-event-handler)))

(mozremote-event-add-handler "Browsing" 'firemacs-browser-event-handler)

;;}}}

(provide 'firemacs)
;;{{{  emacs local variables

;;; local variables:
;;; folded-file: t
;;; byte-compile-dynamic: t
;;; end:

;;}}}

;;; firemacs.el ends here